home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / Demo Macro < prev    next >
Text File  |  1994-04-11  |  6KB  |  344 lines
  1. procedure AdvanceRoi;
  2. begin
  3.   hloc:=hloc+RoiWidth;
  4.   if (hloc+RoiWidth div 2)>PicWidth then begin
  5.     hloc:=0;
  6.     vloc:=vloc+RoiHeight;
  7.   end;
  8.   if (hloc+RoiWidth)>PicWidth then hloc:=PicWidth-RoiWidth;
  9.   if (vloc+RoiHeight)>PicHeight then vloc:=PicHeight-RoiHeight;
  10.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  11. end;
  12.  
  13.  
  14. procedure MakeBlocks(n:integer);
  15. var
  16.   i,hloc,vloc,PicWidth,PicHeight:integer;
  17.   RoiWidth,RoiHeight:integer;
  18.   scale:real;
  19. begin
  20.   GetPicSize(PicWidth,PicHeight);
  21.   scale:=1/n;
  22.   SelectAll;
  23.   SetScaling('Nearest Neighbor; Same Window');
  24.   ScaleAndRotate(scale,scale,0);
  25.   RestoreRoi;
  26.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  27.   copy;
  28.   SelectAll;
  29.   Clear;
  30.   hloc:=0;
  31.   vloc:=0;
  32.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  33.   for i:=1 to n*n do begin
  34.     Paste;
  35.     AdvanceRoi;
  36.   end;
  37.   KillRoi;
  38. end;
  39.  
  40.  
  41. procedure DoTextDemo;
  42. begin
  43.   RevertToSaved;
  44.   MoveTo(100,20);
  45.   SetForegroundColor(255);
  46.   SetBackgroundColor(0);
  47.   SetFont('Geneva');
  48.   SetFontSize(24);
  49.   SetText('No background, Bold, Center');
  50.   Writeln('Text');
  51.   SetText('With background');
  52.   Writeln('With Background');
  53.   SetText('Bold');
  54.   Writeln('Bold');
  55.   SetText('Underlined');
  56.   Writeln('Underlined');
  57.   SetText('Italic');
  58.   Writeln('Italics');
  59.   SetText('Outline');
  60.   Writeln('Outlined');
  61.   SetText('Shadow');
  62.   Writeln('Shadowed');
  63.   SetText('Plain');
  64.   SetFontSize(9);
  65.   MoveTo(100,240);
  66.   Writeln('Very small');
  67.   wait(.5);
  68.   SetFontSize(24);
  69.   MoveTo(100,240);
  70.   Writeln('Small');
  71.   wait(.5);
  72.   SetFontSize(48);
  73.   MoveTo(100,240);
  74.   SetText('Bold');
  75.   Writeln('MEDIAN');
  76.   wait(.5);
  77.   SetFontSize(96);
  78.   MoveTo(100,240);
  79.   Writeln('LARGE');
  80.   wait(1);
  81. end;
  82.  
  83.  
  84. procedure DrawGrayLevelScale(nBoxes:integer);
  85. var
  86.   PicWidth, PicHeight,i,GrayLevel,hloc,vloc,width,height,vdelta:integer;
  87. begin
  88.   GetPicSize(PicWidth,PicHeight);
  89.   SetFont('Helvetica');
  90.   SetFontSize(9);
  91.   SetText('Bold; Center; with background');
  92.   SetBackgroundColor(0);
  93.   width:=0.9*PicHeight/nBoxes;
  94.   height:=width;
  95.   hloc:=0.05*PicHeight;
  96.   vloc:=hloc;
  97.   vdelta:=height-1;
  98.   GrayLevel:=0;
  99.   for i:=1 to nBoxes do begin
  100.     MakeRoi(hloc,vloc,width,height);
  101.     SetForeground(GrayLevel);
  102.     Fill;
  103.     SetForeground(255);
  104.     DrawBoundary;
  105.     MoveTo(hloc+width/2,vloc+height/2);
  106.     Writeln(GrayLevel);
  107.     GrayLevel:=GrayLevel+trunc(256/nBoxes);
  108.     vloc:=vloc+vdelta;
  109.   end;
  110. end;
  111.  
  112.  
  113. procedure DrawColorScale;
  114. var
  115.   top,left,width,height,nLabels,i,tvloc:integer;
  116. begin
  117.   nLabels:=16;
  118.   SetFontSize(12);
  119.   SetFont('Helvetica');
  120.   SetText('Right Justified');
  121.   DrawScale;
  122.   GetRoi(left,top,width,height);
  123.   KillRoi;
  124.   SetForeground(255); {black}
  125.   SetBackground(0); {255}
  126.   vloc:=top;
  127.   for i:=1 to nLabels do begin
  128.     MoveTo(left+width+25,vloc+3);
  129.     tvloc:=vloc;
  130.     if tvloc>(top+height-1) then tvloc:=Top+height-1;
  131.     Writeln(GetPixel(left,tvloc));
  132.     vloc:=vloc+round(height/(nLabels-1));
  133.   end; 
  134. end;
  135.  
  136.  
  137. procedure DoColorScaleDemo;
  138. var
  139.   PicWidth,PicHeight,hloc,vloc,ScaleWidth,ScaleHeight:integer;
  140. begin
  141.   GetPicSize(PicWidth,PicHeight);
  142.   width:=0.1*PicWidth;
  143.   if width>40 then width:=40;
  144.   height:=0.9*PicHeight;
  145.   hloc:=0.05*PicHeight;
  146.   vloc:=hloc;
  147.   SetPalette('Spectrum');
  148.   MakeRoi(hloc,vloc,width,height);
  149.   DrawColorScale;
  150.   wait(2);
  151.   SetPalette('Grayscale');
  152. end;
  153.  
  154.  
  155. procedure DemoFilters;
  156. var
  157.   hloc,vloc,RoiWidth,RoiHeight,PicWidth,PicHeight:integer;
  158. begin
  159.   MakeBlocks(3);
  160.   RestoreRoi;
  161.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  162.   GetPicSize(PicWidth,PicHeight);
  163.   hloc:=0; vloc:=0;
  164.   AdvanceRoi;
  165.   SetOption; Sharpen;
  166.   AdvanceRoi;
  167.   Shadow;
  168.   AdvanceRoi;
  169.   TraceEdges;
  170.   AdvanceRoi;
  171.   SetOption; Smooth;
  172.   TraceEdges;
  173.   Skeletonize;
  174.   AdvanceRoi;
  175.   Dither;
  176.   AdvanceRoi;
  177.   Invert;
  178.   AdvanceRoi;
  179.   FlipVertical;
  180.   AdvanceRoi;
  181.   FlipHorizontal;
  182. end;
  183.  
  184.  
  185. procedure MakeGrayLevelGrid;
  186. var
  187.   i,hloc,vloc,PicWidth,PicHeight:integer;
  188.   RoiWidth,RoiHeight,GrayLevel,increment:integer;
  189.   scale:real;
  190. begin
  191.   n:=5;
  192.   GetPicSize(PicWidth,PicHeight);
  193.   hloc:=0;
  194.   vloc:=0;
  195.   RoiWidth:=PicWidth div n;
  196.   RoiHeight:=PicHeight div n;
  197.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  198.   GrayLevel:=255;
  199.   increment:=round(256/(n*n));
  200.   SetLineWidth(1);
  201.   for i:=1 to n*n do begin
  202.     SetForeground(GrayLevel);
  203.     fill;
  204.     SetForeground(0);
  205.     DrawBoundary;
  206.     GrayLevel:=GrayLevel-increment;
  207.     if GrayLevel<0 then GrayLevel:=0;
  208.     AdvanceRoi;
  209.   end;
  210.   KillRoi;
  211. end;
  212.  
  213.  
  214. macro 'Demo Macro [D]'
  215. {
  216. This macro demonstrate many of the features available in Image's macro
  217. language. It assumes the Image at least as large as`256x256 has been opened.
  218. }
  219. var
  220.   i:integer;
  221.   width,height,n,W,H:integer;
  222.   scale:real;
  223.   NoImage:boolean;
  224.   StartTicks,time:real;
  225. begin
  226.   StartTicks:=TickCount;
  227.   NoImage:=nPics<>1;
  228.   if not NoImage then GetPicSize(width,height);
  229.   if NoImage or (width<256) or (height<256) then begin
  230.     PutMessage('This macro needs a single image at least 256 pixels wide and 256 pixels high  to operate on.');
  231.     Exit;
  232.   end;
  233.  
  234.   SaveState;
  235.   DemoFilters;
  236.   wait(2);
  237.  
  238.   RevertToSaved;
  239.   MakeGrayLevelGrid;
  240.   wait(1);
  241.  
  242.   RevertToSaved;
  243.   DrawGrayLevelScale(12);
  244.   wait(1);
  245.  
  246.   RevertToSaved;
  247.   DoColorScaleDemo;
  248.  
  249.   DoTextDemo;
  250.  
  251.  
  252.   RevertToSaved;
  253.   SetScaling('Nearest Neighbor; Same Window');
  254.   for i:= 1 to 4 do begin
  255.     ScaleAndRotate(1.5,1.5,0);
  256.     wait(.5);
  257.   end;
  258.  
  259.   RevertToSaved;
  260.   for i:=1 to 6 do begin
  261.     ScaleAndRotate(0.6,0.6,0);
  262.     wait(.5);
  263.     RestoreRoi;
  264.   end;
  265.  
  266.   RevertToSaved;
  267.   wait(.5);
  268.   ScaleAndRotate(.333,1,0);
  269.   wait(1);
  270.   Undo;
  271.   ScaleAndRotate(1,.333,0);
  272.   wait(1);
  273.  
  274.   Undo;
  275.   FlipVertical;
  276.   wait(.5);
  277.   Undo;
  278.   FlipHorizontal;
  279.   wait(.5);
  280.   Undo;
  281.   RotateRight(true);
  282.   RotateLeft(true);
  283.  
  284.   Shadow;
  285.   Wait(1);
  286.  
  287.   Undo;
  288.   Duplicate('Temp');
  289.   Smooth;
  290.   for i:=1 to 3 do begin SetOption; Sharpen end;
  291.   wait(.5);
  292.   Dispose;
  293.   SelectPic(1);
  294.   Dither;
  295.   wait(.5);
  296.  
  297.   Undo;
  298.   AddConstant(100);
  299.   Wait(1);
  300.   Undo;
  301.   AddConstant(-100);
  302.   Wait(1);
  303.   EnhanceContrast;
  304.   Wait(.5);
  305.   Undo;
  306.   EqualizeHistogram;
  307.   Wait(.5);
  308.   ResetGraymap;
  309.   ShowHistogram;
  310.  
  311.   Smooth;
  312.   TraceEdges;
  313.   wait(.5);
  314.   Erode;
  315.   Dilate;
  316.   Outline;
  317.   Undo;
  318.   Skeletonize;
  319.   Wait(1);
  320.   for i:= 1 to 12 do TraceEdges;
  321.   RestoreState;
  322.   time:=(TickCount-StartTicks)/60;
  323.   ShowMessage('time=',time:1:2,' seconds');
  324. end;
  325.  
  326.  
  327. macro 'Make Wallpaperâ•” [M]'
  328. var
  329.   width,height,n:integer;
  330. begin
  331.   GetPicSize(width,height);
  332.   if (width=0) then begin
  333.     PutMessage('This macro needs an image to operate on.');
  334.     Exit;
  335.   end;
  336.   n:=trunc(GetNumber('Replication factor:',8));
  337.   SaveState;
  338.   MakeBlocks(n);
  339.   RestoreState;
  340. end;
  341.  
  342.  
  343.  
  344.